home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
UTILITY1
/
FDUMP102.ZIP
/
FILEDUMP.FRM
< prev
next >
Wrap
Text File
|
1993-10-12
|
36KB
|
1,072 lines
VERSION 2.00
Begin Form Form_Main
ClientHeight = 4860
ClientLeft = 1140
ClientTop = 1680
ClientWidth = 8070
Height = 5550
Icon = FILEDUMP.FRX:0000
Left = 1080
LinkTopic = "Form1"
ScaleHeight = 4860
ScaleWidth = 8070
Top = 1050
Width = 8190
Begin CommandButton cbNext
Caption = "Next"
Height = 212
Left = 6840
TabIndex = 2
Top = 4560
Visible = 0 'False
Width = 615
End
Begin CommandButton cbPrev
Caption = "Prev"
Height = 212
Left = 600
TabIndex = 1
Top = 4560
Visible = 0 'False
Width = 615
End
Begin CommonDialog CMDialog1
FontName = "Courier New"
FontSize = 10
InitDir = "C:\"
Left = 0
Top = 4320
End
Begin ListBox GrpDetail
FontBold = -1 'True
FontItalic = 0 'False
FontName = "Courier New"
FontSize = 8.25
FontStrikethru = 0 'False
FontUnderline = 0 'False
Height = 3600
Left = 0
TabIndex = 0
TabStop = 0 'False
Top = 0
Width = 8055
End
Begin Label lblFileSize
Alignment = 2 'Center
Height = 210
Left = 1440
TabIndex = 3
Top = 4560
Width = 5175
End
Begin Menu M_File
Caption = "&File"
Begin Menu M_FileOpen
Caption = "&Open"
End
Begin Menu M_FilePrint
Caption = "&Print"
End
Begin Menu M_FileBar1
Caption = "-"
End
Begin Menu M_FileExit
Caption = "E&xit"
End
End
Begin Menu M_Help
Caption = "&Help"
Begin Menu M_HelpAbout
Caption = "&About"
End
End
End
Option Explicit
'
'--------------------------------------------------------
' Module Level Globals
'--------------------------------------------------------
Dim imPixelsPerChar As Integer
Dim fmForm_MainTopDefault As Single
Dim smSourceFileName As String
Dim imMaxRecord As Integer
Dim imPriorShow As Integer
'
Dim imBlockStarts(50) As Integer
Dim imBlockNumber As Integer
'
Const ICON_TWIPS = 540
Const MIN_WIDTH = 8070
Const MIN_HEIGHT = 4650
Const BLOCK_SIZE = 4096
'
'--------------------------------------------------------
'--------------------------------------------------------
Sub cbNext_Click ()
'
Dim sBuffer As String
Dim iEndOfFileFlag As Integer
'
' Update BlockStarts Vector Pointer
If imBlockStarts(imBlockNumber + 1) > imBlockStarts(imBlockNumber) Then
imBlockNumber = imBlockNumber + 1
End If
'
cbNext.Visible = False
cbPrev.Visible = False
'
iEndOfFileFlag = False
GrpDetail.Clear
Form_Main.MousePointer = HOURGLASS
Call ReadBack(sgWorkFileName, imBlockStarts(imBlockNumber), imMaxRecord, iEndOfFileFlag, sBuffer)
Form_Main.MousePointer = DEFAULT
Debug.Print "cbNext_Click: ";
Debug.Print "imBlockStarts("; imBlockNumber; ")=";
Debug.Print imBlockStarts(imBlockNumber)
'
' Update BlockStarts Vector
If imBlockStarts(imBlockNumber + 1) <= imBlockStarts(imBlockNumber) Then
imBlockStarts(imBlockNumber + 1) = imBlockStarts(imBlockNumber) + GrpDetail.ListCount
Debug.Print "cbNext_Click: GrpDetail.ListCount=";
Debug.Print GrpDetail.ListCount;
Debug.Print " imMaxRecord="; imMaxRecord;
Debug.Print " imBlockStarts("; imBlockNumber + 1; ")=";
Debug.Print imBlockStarts(imBlockNumber + 1)
End If
'
'
If imBlockNumber > 1 Then
cbPrev.Visible = True
End If
'
If imBlockStarts(imBlockNumber + 1) < imMaxRecord Then
cbNext.Visible = True
End If
End Sub
'--------------------------------------------------------
'--------------------------------------------------------
Sub cbPrev_Click ()
'
Dim sBuffer As String
Dim iEndOfFileFlag As Integer
'
' Update BlockStarts Vector Pointer
imBlockNumber = imBlockNumber - 1
'
cbNext.Visible = False
cbPrev.Visible = False
'
iEndOfFileFlag = False
GrpDetail.Clear
Form_Main.MousePointer = HOURGLASS
Call ReadBack(sgWorkFileName, imBlockStarts(imBlockNumber), imMaxRecord, iEndOfFileFlag, sBuffer)
Form_Main.MousePointer = DEFAULT
Debug.Print "cbPrev_Click: ";
Debug.Print "imBlockStarts("; imBlockNumber; ")=";
Debug.Print imBlockStarts(imBlockNumber)
'
Debug.Print "cbPrev_Click: GrpDetail.ListCount=";
Debug.Print GrpDetail.ListCount;
Debug.Print " imMaxRecord="; imMaxRecord;
Debug.Print " imBlockStarts("; imBlockNumber + 1; ")=";
Debug.Print imBlockStarts(imBlockNumber + 1)
'
'
If imBlockNumber > 1 Then
cbPrev.Visible = True
End If
'
If imBlockStarts(imBlockNumber) < imMaxRecord Then
cbNext.Visible = True
End If
End Sub
'---------------------------------------------------------
' Process Form_Load Event
'---------------------------------------------------------
Sub Form_Load ()
'
'' Set Global Program ID Values
sgProgramName = App.EXEName 'Set Program Name
sgRegistrationStatus = "Un-Registered Shareware"
sgProgramVersion = "1.02"
sgCompuserveID = "71055,1043"
'
' Debug.Print "CurDir$="; CurDir$
' Debug.Print "App.Path="; App.Path
If Right(App.Path, 1) <> "\" Then
sgWorkFileName = App.Path & "\FILEDUMP.TMP"
Else
sgWorkFileName = App.Path & "FILEDUMP.TMP"
End If
' Debug.Print "sgWorkFileName="; sgWorkFileName
'
' fmForm_MainTopDefault = 10 'Set Production Top
fmForm_MainTopDefault = 1065 'Set Debugging Top
imPixelsPerChar = 8
'
GrpDetail.Height = 4230 'Force Height
'
Form_Main.Caption = sgProgramName & " " & sgProgramVersion
'
'' Insure only one instance is running
If App.PrevInstance Then
MsgBox App.EXEName & " is already running!" & Chr$(10) & " Second instance has been cancelled.", MB_ICONEXCLAMATION
End
End If
'
'' Set Default Screen Sizing Values
Form_Main.ScaleMode = TWIPS
'
fgCurrentHeightFactor = 1
fgCurrentWidthFactor = 1
'
fgBaseFormLeft = Form_Main.Left
fgBaseFormTop = Form_Main.Top
fgBaseFormWidth = Form_Main.Width
fgBaseFormHeight = Form_Main.Height
' Debug.Print "Form_Load Base: "; fgBaseFormLeft; fgBaseFormTop; fgBaseFormWidth; fgBaseFormHeight
' Printer.Print Tab(25); " Left"; Tab(33); "Top"; Tab(40); "Width"; Tab(47); "Height"
' Printer.Print "Form_Load Base: "; Tab(25); fgBaseFormLeft; Tab(33); fgBaseFormTop; Tab(40); fgBaseFormWidth; Tab(47); fgBaseFormHeight
' Printer.Print " GrpDetail: "; Tab(25); GrpDetail.Left; Tab(33); GrpDetail.Top; Tab(40); GrpDetail.Width; Tab(47); GrpDetail.Height
' Printer.Print " cbPrev:"; Tab(25); cbPrev.Left; Tab(33); cbPrev.Top; Tab(40); cbPrev.Width; Tab(47); cbPrev.Height
' Printer.Print " cbNext:"; Tab(25); cbNext.Left; Tab(33); cbNext.Top; Tab(40); cbNext.Width; Tab(47); cbNext.Height
' Printer.Print " lblFileSize:"; Tab(25); lblFileSize.Left; Tab(33); lblFileSize.Top; Tab(40); lblFileSize.Width; Tab(47); lblFileSize.Height
'
'' Make sure Form will fit the Screen Size
If fgBaseFormLeft + fgBaseFormWidth > Screen.Width Then
MsgBox "The program calls for Higher Horizontal Resolution." & Chr$(10) & " -- The Default Maximum will be used.", MB_ICONEXCLAMATION
fgBaseFormLeft = 10
fgBaseFormWidth = Screen.Width - fgBaseFormLeft
End If
'
If fgBaseFormTop + fgBaseFormHeight > Screen.Height Then